home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The 640 MEG Shareware Studio 2
/
The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO
/
basic
/
pqmenu.zip
/
PULLDOWN.BAS
< prev
next >
Wrap
BASIC Source File
|
1992-02-22
|
17KB
|
465 lines
DEFINT A-Z
'$INCLUDE: 'pqmenu.bi'
'$DYNAMIC
DIM SHARED mouse
CALL MMCHECK(mouse)
COLOR 7, 1
CLS
MenuColor = 7
frame = 1
framecolor = 4
TEXTCOLOR = 0
HotKeyColor = 15
BarColor = 4
Inactive = 8
REDIM PullDown(4) AS MenuItems
PullDown(1).titles = "FILE"
PullDown(1).items = "OPEN/SAVE/MERGE/CREATE"
PullDown(1).HotKey = "1F/1O1/1S1/1M1/1C0"
PullDown(1).position = 4
PullDown(2).titles = "EDIT"
PullDown(2).items = "CUT/COPY/PASTE/CLEAR"
PullDown(2).HotKey = "1E/1C1/2O1/1P1/2L1"
PullDown(2).position = 10
PullDown(3).titles = "OPTIONS"
PullDown(3).items = "DISPLAY/Right Mouse/Screens"
PullDown(3).HotKey = "1O/1D1/7M1/1S1"
PullDown(3).position = 16
PullDown(4).titles = "HELP"
PullDown(4).items = "Main/Get Mouse/Screens"
PullDown(4).HotKey = "1H/1M1/1G0/1S1"
PullDown(4).position = 60
CALL MENU(PullDown(), MenuColor, frame, framecolor, TEXTCOLOR, HotKeyColor, BarColor, Inactive, choice$, click%)
DO
CALL MMCURSORON
CALL GetKey4(mouse, asccode, scancode, click, rgt, alt)
IF alt = -1 THEN click = alt
CALL MENU(PullDown(), MenuColor, frame, framecolor, TEXTCOLOR, HotKeyColor, BarColor, Inactive, choice$, click%)
CALL MMCURSORON
LOOP
END
' '$INCLUDE: 'pqmenu.bi'
REM $STATIC
FUNCTION largest (picks$(), count)
bb = 0
FOR i = 1 TO count
IF LEN(picks$(i)) > bb THEN bb = LEN(picks$(i))
NEXT i
largest = bb
END FUNCTION
SUB MENU (PullDown() AS MenuItems, MenuColor, frame, framecolor, TEXTCOLOR, HotKeyColor, BarColor, Inactive, choice$, click)
LOCATE 1, 1, 0
choice$ = ""
'............SET COLORS AND DIMENTION ARRAYS............................
CALL CALCATTR(MenuItems, MenuColor, mencol)
CALL CALCATTR(MenuItems, BarColor, bar)
CALL CALCATTR(HotKeyColor, MenuColor, KeyColor)
CALL CALCATTR(HotKeyColor, BarColor, RevKeyColor)
CALL CALCATTR(Inactive, MenuColor, Inact)
NumberOfTitles = UBOUND(PullDown)
REDIM header$(1)
'.......................................................................
'......PRINT MAIN MENU BAR......................................
' PBINDEX
REDIM mbar(1 TO NumberOfTitles) AS ColorBarPos
recol: CALL XQPRINT(SPACE$(80), 1, 1, mencol, 0, 0)
FOR i = 1 TO NumberOfTitles
CALL XQPRINT(PullDown(i).titles, 1, PullDown(i).position, mencol, 0, 0)
mbar(i).ULR = 1: mbar(i).ulc = PullDown(i).position - 1
mbar(i).LRR = 1:
mbar(i).lrc = LEN(LTRIM$(RTRIM$(PullDown(i).titles))) + mbar(i).ulc + 1
NEXT i
IF asccode = 27 THEN EXIT SUB
IF choice$ <> "" THEN EXIT SUB
IF click = 0 THEN EXIT SUB
'.......................................................................
'.......HIGHLIGHT HOT KEYS.............................................
'CALL ParseDelimited(pulldown(Element).HotKey, "/", header$(), count, 3)
FOR i = 1 TO NumberOfTitles
highlight = mbar(i).ulc + VAL(MID$(PullDown(i).HotKey, 1, 1))
CALL RECOLORAREA(1, highlight, 1, highlight, KeyColor, 0, -1)
NEXT i
CALL RECOLORAREA(mbar(1).ULR, mbar(1).ulc, mbar(1).LRR, mbar(1).lrc, bar, 0, 0)
highlight = mbar(1).ulc + VAL(MID$(PullDown(1).HotKey, 1, 1))
CALL RECOLORAREA(1, highlight, 1, highlight, RevKeyColor, 0, -1)
'...................................................................
'..............GET INPUT// CHECK FOR HOT KEY PRESS..................
Element = 1
IF click > 0 THEN
CALL MMCURSOROFF
lft = 1
GOTO clk
END IF
DO
CALL MMCURSORON
CALL Getkey(mouse, asccode, scancode, lft, rgt)
aa$ = UCASE$(CHR$(asccode))
asccode = ASC(aa$)
CALL MMCURSOROFF
IF rgt > 0 THEN asccode = 27
IF asccode = 27 THEN GOTO recol
clk: 'IF click > 0 THEN CALL MMCURSORON
IF lft > 0 THEN
CALL MMCLICK(lft, rgt)
CALL LCLICKLOC(mrow, mcol)
IF mrow = 1 THEN
FOR i = 1 TO NumberOfTitles
range = LEN(LTRIM$(RTRIM$(PullDown(i).titles)))
IF mcol >= PullDown(i).position AND mcol < PullDown(i).position + range THEN
OldElement = Element
highlight = mbar(Element).ulc + VAL(MID$(PullDown(Element).HotKey, 1, 1))
CALL RECOLORAREA(mbar(OldElement).ULR, mbar(OldElement).ulc, mbar(OldElement).LRR, mbar(OldElement).lrc, mencol, 0, 0)
CALL RECOLORAREA(1, highlight, 1, highlight, KeyColor, 0, -1)
scancode = 80
Element = i
CALL RECOLORAREA(mbar(Element).ULR, mbar(Element).ulc, mbar(Element).LRR, mbar(Element).lrc, bar, 0, 0)
highlight = mbar(Element).ulc + VAL(MID$(PullDown(Element).HotKey, 1, 1))
CALL RECOLORAREA(1, highlight, 1, highlight, RevKeyColor, 0, -1)
EXIT FOR
END IF
NEXT i
ELSE asccode = 27
GOTO recol
END IF
END IF
'......HOT KEY PRESS
IF lft = 0 THEN
FOR i = 1 TO NumberOfTitles
IF ASC(MID$(PullDown(i).HotKey, 2, 1)) = asccode THEN
OldElement = Element
highlight = mbar(Element).ulc + VAL(MID$(PullDown(Element).HotKey, 1, 1))
CALL RECOLORAREA(mbar(OldElement).ULR, mbar(OldElement).ulc, mbar(OldElement).LRR, mbar(OldElement).lrc, mencol, 0, 0)
CALL RECOLORAREA(1, highlight, 1, highlight, KeyColor, 0, -1)
Element = i
CALL RECOLORAREA(1, 1, 1, 80, mencol, 0, -1)
CALL RECOLORAREA(mbar(Element).ULR, mbar(Element).ulc, mbar(Element).LRR, mbar(Element).lrc, bar, 0, 0)
scancode = 80
EXIT FOR
END IF
NEXT i
END IF
'.......................................................................
click = 0
'..............GET INPUT// CHECK FOR ARROW KEY OR ENTER KEY PRES..........
SELECT CASE scancode
CASE IS = 77
OldElement = Element
highlight = mbar(Element).ulc + VAL(MID$(PullDown(Element).HotKey, 1, 1))
CALL RECOLORAREA(mbar(OldElement).ULR, mbar(OldElement).ulc, mbar(OldElement).LRR, mbar(OldElement).lrc, mencol, 0, 0)
CALL RECOLORAREA(1, highlight, 1, highlight, KeyColor, 0, -1)
Element = Element + 1
IF Element > NumberOfTitles THEN Element = 1
CALL RECOLORAREA(mbar(Element).ULR, mbar(Element).ulc, mbar(Element).LRR, mbar(Element).lrc, bar, 0, 0)
highlight = mbar(Element).ulc + VAL(MID$(PullDown(Element).HotKey, 1, 1))
CALL RECOLORAREA(1, highlight, 1, highlight, RevKeyColor, 0, -1)
CASE IS = 75
OldElement = Element
highlight = mbar(Element).ulc + VAL(MID$(PullDown(Element).HotKey, 1, 1))
CALL RECOLORAREA(mbar(OldElement).ULR, mbar(OldElement).ulc, mbar(OldElement).LRR, mbar(OldElement).lrc, mencol, 0, 0)
CALL RECOLORAREA(1, highlight, 1, highlight, KeyColor, 0, -1)
Element = Element - 1
IF Element < 1 THEN Element = NumberOfTitles
CALL RECOLORAREA(mbar(Element).ULR, mbar(Element).ulc, mbar(Element).LRR, mbar(Element).lrc, bar, 0, 0)
highlight = mbar(Element).ulc + VAL(MID$(PullDown(Element).HotKey, 1, 1))
CALL RECOLORAREA(1, highlight, 1, highlight, RevKeyColor, 0, -1)
CASE IS = 80, 28, 224
'CALL RECOLORAREA(1, 1, 1, 80, mencol, 0, -1)
'STOP
CALL ShowMenu(Element, PullDown(), NumberOfTitles, bar, mencol, frame, framecolor, Inact, KeyColor, RevKeyColor, mbar(), choice$)
IF choice$ = "" THEN asccode = 27
CALL MMCURSOROFF
GOTO recol
END SELECT
'.........................................................................
LOOP
'SLEEP 4
CLS
END SUB
SUB ShowMenu (Element, PullDown() AS MenuItems, NumberOfTitles, bar, mencol, frame, framecolor, Inact, KeyColor, RevKeyColor, mbar() AS ColorBarPos, choice$)
'..........break down items into Picks$ for easy access
redo: REDIM picks$(1)
REDIM Attributes$(1)
CALL ParseDelimited(PullDown(Element).items, "/", picks$(), count, 3)
CALL ParseDelimited(PullDown(Element).HotKey, "/", Attributes$(), AttrCount, 3)
'.................................................................. PBINDEX
'...............set positions for verticle color bar.............PBINDEX
'....AND CALCIULATE AND SHOW MENU WINDOW. SAVE SCREEN UNDER WINDOW
REDIM Vbar(1 TO count) AS ColorBarPos
ULR = 3
ulc = PullDown(Element).position - 1
LRR = 2 + count
lrc = largest(picks$(), count) + 2 + ulc
CALL UNCALCATTR(fore, back, mencol)
grow = 0
shadow = -3
SCRMODE = -1
PAGE = 0
CALL CALCSIZE(ULR - 1, ulc - 1, LRR + 2, lrc + 3, scrsize)
REDIM holdback(scrsize)
DSEG = VARSEG(holdback(1))
DOFS = VARPTR(holdback(1))
CALL DGETSCREEN(DSEG, DOFS, ULR - 1, ulc - 1, LRR + 2, lrc + 3, 0, -1)
CALL WindowManager(ULR, ulc, LRR, lrc, frame, fore, back, grow, shadow, label, label$, PAGE, SCRMODE)
'............................................................PBINDEX
'................PRINT MENU ITEMS...........................................
top = ULR
bulc = ulc + 1
blrc = lrc - 1
FOR i = 1 TO count
IF VAL(MID$(Attributes$(i + 1), 3, 1)) THEN swcolor = mencol ELSE swcolor = Inact
CALL XQPRINT(picks$(i), top - 1 + i, bulc, swcolor, 0, -1)
IF swcolor <> Inact THEN
highlight = ulc + VAL(MID$(Attributes$(i + 1), 1, 1))
CALL RECOLORAREA(top - 1 + i, highlight, top - 1 + i, highlight, KeyColor, 0, -1)
END IF
NEXT i
slide = top
CALL RECOLORAREA(slide, bulc - 1, slide, blrc, bar, 0, -1)
i = 1
IF swcolor <> Inact THEN
highlight = bulc + VAL(MID$(Attributes$(i + 1), 2, 1))
CALL RECOLORAREA(top - 1 + i, highlight, top - 1 + i, highlight, RevKeyColor, 0, -1)
END IF
'........................................................................
DO
llft = 0
CALL MMCURSORON
CALL Getkey(mouse, asccode, scancode, lft, rgt)
aa$ = UCASE$(CHR$(asccode))
asccode = ASC(aa$)
CALL MMCURSOROFF
IF lft > 0 THEN
llft = lft
CALL MMCLICK(lft, rgt)
CALL LCLICKLOC(mrow, mcol)
IF mrow > 2 AND mrow < count + 3 THEN
IF mcol > ulc AND mcol < lrc THEN
place = mrow - 2
IF VAL(MID$(Attributes$(place + 1), 3, 1)) > 0 THEN
choice$ = picks$(place)
CALL DPUTSCREEN(DSEG, DOFS, ULR - 1, ulc - 1, LRR + 2, lrc + 3, PAGE, SCRMODE)
EXIT SUB
ELSE
BEEP
'llft = 0
END IF
ELSE rgt = 1
END IF
ELSE rgt = 1
END IF
END IF
IF llft > 0 AND mrow = 1 THEN
rgt = 0
FOR i = 1 TO NumberOfTitles
range = LEN(LTRIM$(RTRIM$(PullDown(i).titles)))
IF mcol >= PullDown(i).position AND mcol < PullDown(i).position + range THEN
OldElement = Element
highlight = mbar(Element).ulc + VAL(MID$(PullDown(Element).HotKey, 1, 1))
CALL RECOLORAREA(mbar(OldElement).ULR, mbar(OldElement).ulc, mbar(OldElement).LRR, mbar(OldElement).lrc, mencol, 0, 0)
CALL RECOLORAREA(1, highlight, 1, highlight, KeyColor, 0, -1)
scancode = 77
Element = i
CALL RECOLORAREA(mbar(Element).ULR, mbar(Element).ulc, mbar(Element).LRR, mbar(Element).lrc, bar, 0, 0)
highlight = mbar(Element).ulc + VAL(MID$(PullDown(Element).HotKey, 1, 1))
CALL RECOLORAREA(1, highlight, 1, highlight, RevKeyColor, 0, -1)
Element = i - 1
IF Element < 1 THEN Element = NumberOfTitles
EXIT FOR
END IF
NEXT i
END IF
IF rgt > 0 THEN scancode = 1
IF scancode = 1 THEN
CALL DPUTSCREEN(DSEG, DOFS, ULR - 1, ulc - 1, LRR + 2, lrc + 3, PAGE, SCRMODE)
EXIT SUB
END IF
'......HOT KEY PRESS
IF lft = 0 THEN
FOR i = 2 TO AttrCount
IF ASC(MID$(Attributes$(i), 2, 1)) = asccode THEN
IF VAL(MID$(Attributes$(i), 3, 1)) > 0 THEN
choice$ = picks$(i - 1)
CALL DPUTSCREEN(DSEG, DOFS, ULR - 1, ulc - 1, LRR + 2, lrc + 3, PAGE, SCRMODE)
EXIT SUB
'ELSE BEEP
END IF
END IF
NEXT i
END IF
'.......................................................................
SELECT CASE scancode
CASE IS = 77
OldElement = Element
highlight = mbar(Element).ulc + VAL(MID$(PullDown(Element).HotKey, 1, 1))
CALL RECOLORAREA(mbar(OldElement).ULR, mbar(OldElement).ulc, mbar(OldElement).LRR, mbar(OldElement).lrc, mencol, 0, 0)
CALL RECOLORAREA(1, highlight, 1, highlight, KeyColor, 0, -1)
Element = Element + 1
IF Element > NumberOfTitles THEN Element = 1
CALL RECOLORAREA(mbar(Element).ULR, mbar(Element).ulc, mbar(Element).LRR, mbar(Element).lrc, bar, 0, 0)
highlight = mbar(Element).ulc + VAL(MID$(PullDown(Element).HotKey, 1, 1))
CALL RECOLORAREA(1, highlight, 1, highlight, RevKeyColor, 0, -1)
CALL DPUTSCREEN(DSEG, DOFS, ULR - 1, ulc - 1, LRR + 2, lrc + 3, PAGE, SCRMODE)
GOTO redo
CASE IS = 75
OldElement = Element
highlight = mbar(Element).ulc + VAL(MID$(PullDown(Element).HotKey, 1, 1))
CALL RECOLORAREA(mbar(OldElement).ULR, mbar(OldElement).ulc, mbar(OldElement).LRR, mbar(OldElement).lrc, mencol, 0, 0)
CALL RECOLORAREA(1, highlight, 1, highlight, KeyColor, 0, -1)
Element = Element - 1
IF Element < 1 THEN Element = NumberOfTitles
CALL RECOLORAREA(mbar(Element).ULR, mbar(Element).ulc, mbar(Element).LRR, mbar(Element).lrc, bar, 0, 0)
highlight = mbar(Element).ulc + VAL(MID$(PullDown(Element).HotKey, 1, 1))
CALL RECOLORAREA(1, highlight, 1, highlight, RevKeyColor, 0, -1)
CALL DPUTSCREEN(DSEG, DOFS, ULR - 1, ulc - 1, LRR + 2, lrc + 3, PAGE, SCRMODE)
GOTO redo
CASE IS = 80
OldElement = slide
IF VAL(MID$(Attributes$(OldElement - 1), 3, 1)) THEN
CALL RECOLORAREA(OldElement, bulc - 1, OldElement, blrc, mencol, 0, -1)
highlight = bulc + VAL(MID$(Attributes$(OldElement - 1), 2, 1))
CALL RECOLORAREA(top - 3 + OldElement, highlight, top - 3 + OldElement, highlight, KeyColor, 0, -1)
ELSE
CALL RECOLORAREA(OldElement, bulc - 1, OldElement, blrc, Inact, 0, -1)
END IF
slide = slide + 1
IF slide > count + 2 THEN slide = top
CALL RECOLORAREA(slide, bulc - 1, slide, blrc, bar, 0, -1)
IF VAL(MID$(Attributes$(slide - 1), 3, 1)) THEN
highlight = bulc + VAL(MID$(Attributes$(OldElement - 1), 2, 1))
CALL RECOLORAREA(top - 3 + slide, highlight, top - 3 + slide, highlight, RevKeyColor, 0, -1)
END IF
CASE IS = 72
OldElement = slide
IF VAL(MID$(Attributes$(OldElement - 1), 3, 1)) THEN
CALL RECOLORAREA(OldElement, bulc - 1, OldElement, blrc, mencol, 0, -1)
highlight = bulc + VAL(MID$(Attributes$(OldElement - 1), 2, 1))
CALL RECOLORAREA(top - 3 + OldElement, highlight, top - 3 + OldElement, highlight, KeyColor, 0, -1)
ELSE
CALL RECOLORAREA(OldElement, bulc - 1, OldElement, blrc, Inact, 0, -1)
END IF
slide = slide - 1
IF slide < top THEN slide = count + 2
CALL RECOLORAREA(slide, bulc - 1, slide, blrc, bar, 0, -1)
IF VAL(MID$(Attributes$(slide - 1), 3, 1)) THEN
highlight = bulc + VAL(MID$(Attributes$(OldElement - 1), 2, 1))
CALL RECOLORAREA(top - 3 + slide, highlight, top - 3 + slide, highlight, RevKeyColor, 0, -1)
END IF
CASE IS = 28, 224
'pbindex
IF VAL(MID$(Attributes$(slide - 1), 3, 1)) > 0 THEN
choice$ = picks$(slide - 2)
CALL DPUTSCREEN(DSEG, DOFS, ULR - 1, ulc - 1, LRR + 2, lrc + 3, PAGE, SCRMODE)
EXIT SUB
ELSE BEEP
END IF
END SELECT
CALL MMCURSORON
LOOP
'CALL RECOLORAREA(Mbar(1).ulr, Mbar(1).ulc, Mbar(1).lrr, Mbar(1).lrc, bar, 0, 0)
'CALL XQPRINT(pulldown(i).titles, 1, pulldown(i).position, mencol, 0, 0)
'Mbar(i).ulr = 1: Mbar(i).ulc = pulldown(i).position - 1
'Mbar(i).lrr = 1:
'Mbar(i).lrc = LEN(LTRIM$(RTRIM$(pulldown(i).titles))) + Mbar(i).ulc + 1
'NEXT i
'CALL RECOLORAREA(Mbar(1).ulr, Mbar(1).ulc, Mbar(1).lrr, Mbar(1).lrc, bar, 0, 0)
END SUB